home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / Extras / SysGen / fastio < prev    next >
Encoding:
Text File  |  1989-01-21  |  1.0 KB  |  52 lines
  1. \ FASTIO ... provide buffered output for faster throughput, mdh
  2.  
  3. \ 02-jan-87  mdh  altered so that KEY does not echo.
  4.  
  5. decimal
  6.  
  7. variable outbuf    128 allot
  8. variable #chars    variable fastio?   fastio? off
  9.  
  10. : Wtype  ( addr cnt -- )
  11.   ferror @ >r
  12.   ConsoleOut @ -dup
  13.   IF   -rot fwrite drop
  14.   ELSE 2drop
  15.   THEN
  16.   r> ferror !
  17. ;
  18.  
  19. : <fastemit>  ( char -- , add to buffer, send line if buffer full or cr )
  20.   ( char -- )  +out  ( char' -- )
  21.   dup  #chars @  outbuf + c!  1 #chars +!
  22.   $ 0a =   #chars @ 127 >  or
  23.   IF     outbuf  #chars @ wtype   0 #chars !
  24.   THEN
  25. ;
  26.  
  27. : <flushemit>  ( -- , send chars to console, if appropriate )
  28.   fastio? @
  29.   IF   #chars @
  30.        IF    outbuf  #chars @ wtype   0 #chars !
  31.        THEN
  32.   THEN
  33. ;
  34.  
  35. : fast   ( -- , install fastio )
  36.   ' <fastemit>  is emit   fastio? on
  37.   ' <flushemit> is flushemit
  38.   0 #chars !
  39. ;
  40.  
  41. : slow   ( -- , back to original )
  42.   flushemit
  43.   ' (emit)  is emit       fastio? off
  44.   ' noop    is flushemit
  45.   \ outbuf   #chars @  0
  46.   \ do   dup i + c@  (emit)
  47.   \ loop drop
  48.   0 #chars !
  49. ;
  50.  
  51.  
  52.